perm filename PTRANS.SAI[HAL,HE] blob
sn#121119 filedate 1974-09-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00021 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "ptrans"
C00005 00003 ! Storing table elements
C00007 00004 ! Dealing with labels
C00008 00005 outstr("Pl file to be compiled: ") initscan(instrl(cr),17,TRUE)
C00009 00006 if equ(symb, "EXEC_FILES") then
C00010 00007 else if equ(symb, "DELIMITERS") then
C00012 00008 else if equ(symb,"RESERVED_WORDS") then
C00014 00009 else if equ(symb,"NON_TERMINAL_SYMBOLS") then
C00015 00010 else if equ(symb,"TYPES") then
C00016 00011 else if equ(symb,"CLASSES") then
C00020 00012 else if equ(symb,"PRODUCTIONS") then
C00022 00013 ! Process label
C00023 00014 ! Process left-hand-side
C00026 00015 ! Process right-hand-side
C00028 00016 ! Process exec routines
C00030 00017 ! Process branch instructions
C00031 00018 ! Code and store production
C00033 00019 else
C00034 00020 END
C00035 00021 ! Update tables
C00037 ENDMK
C⊗;
BEGIN "ptrans"
require "INIT[CSP,SYS]" source_file;
INTERNAL SIMPLE PROCEDURE modifscan;
BEGIN "mod"
charclass["↓"] ← delimiter;
charclass["↑"] ← delimiter;
charclass["→"] ← delimiter;
charclass["$"] ← charclass["@"] ← delimiter;
charclass["¬"] ← charclass["≡"] ← delimiter
END;
boolean debugtrans;
define transdebug = ⊂ if debugtrans then outstr ⊃;
define oct(zzz) = ⊂ "'"&cvos(zzz LAND '7777) ⊃;
SIMPLE PROCEDURE errmess(VALUE STRING var);
error(crlf&"??? What the hell is "&var&" doing here?");
integer dummy, i;
integer labnum, rounded; integer array labels[1:200];
integer doubnum; string array doub[1:50];
integer array member, class, nextpair[-9:700]; integer classnum;
integer prodexec, numscan;
integer array exec[1:20];
integer bytpos, el0, el1, el2, bytenum;
integer locresnum, execnum, prodwordnum;
integer labchan, tablechan, exechan;
integer labcount, tablecount, execount;
integer labrchar, tablebrchar, execbrchar;
integer labeof, tableof, execeof;
string labfile, tablefile, execfile;
! Storing table elements;
SIMPLE PROCEDURE stornum(VALUE integer numb);
BEGIN "stornum"
if abs(numb) > 2↑11 then
error("Trying to store number > 2↑11"&crlf&"Number is: "&numb);
bytenum ← bytenum + 1;
case bytpos of
BEGIN
BEGIN
el0 ← numb land '7777;
bytpos ← 1
END;
BEGIN
el1 ← numb land '7777;
bytpos ← 2
END;
BEGIN
string outp;
prodwordnum ← prodwordnum + 1;
if prodwordnum mod 5 = 1 then
out(tablechan,crlf);
bytpos ← 0; el2 ← numb land '7777;
outp ← "'"&cvos(el0 lsh 24 + el1 lsh 12 + el2)&",";
if length(outp) < 8 then
outp ← outp&tab;
out(tablechan,outp&tab)
END
END
END;
! Dealing with labels;
SIMPLE integer PROCEDURE evalabel;
BEGIN "evlab"
transdebug(crlf&tab);
if token = tnondeclared then
BEGIN
entri:rtype[new_id] ← tlabel;
entri:val[new_id] ← labnum ← labnum + 1;
transdebug("Label "&symb&" given number "&oct(labnum));
return(labnum)
END
else if token = tlabel then
BEGIN
integer result;
result ← entri:val[new_id];
transdebug("Label "&symb&" is number "&oct(result));
return(result)
END
else
BEGIN
error(symb&" cannot be label.");
return(0)
END
END;
outstr("Pl file to be compiled: "); initscan(instrl(cr),17,TRUE);
if please_answer("Initial symbol table printout?") then
printable(1);
labfile ← "LAB.SAI";
execfile ← "EXEC.SAI";
tablefile ← "TABLE.SAI";
open_lookup_enter(tablefile,tablechan,
"DSK",0,0,17,
tablecount,tablebrchar,tableof);
do
BEGIN "newheader"
lexan;
if equ(symb, "EXEC_FILES") then
BEGIN "exfiles"
open_lookup_enter(labfile,labchan,
"DSK",0,0,17,
labcount,labrchar,labeof);
lexan; while token ≠ "$" ∧ token ≠ tendfile do
BEGIN
if token ≠ tidentifier then
error(symb &"?? exec file must be identifier!")
else
out(labchan,"REQUIRE """&symb&
""" SOURCE_FILE;"&crlf);
lexan
END
END
else if equ(symb, "DELIMITERS") then
BEGIN "delims"
integer array tempchar[0:127];
debugtrans ← please_answer("List of delimiters?");
out(tablechan,crlf&"INTERNAL SIMPLE PROCEDURE MODIFSCAN;");
for i ← 0 step 1 until 127 do
BEGIN
tempchar[i] ← charclass[i];
if charclass[i] ≠ ignored ∧ charclass[i] ≠ quote then
charclass[i] ← delimiter
END;
out(tablechan,crlf&tab&"BEGIN");
lexan; while token ≠ "$" ∧ token ≠ tendfile do
BEGIN
out(tablechan,";"&crlf&tab&
"CHARCLASS["""&symb[1 for 1]&"""] ← DELIMITER");
tempchar[symb[1 for 1]] ← delimiter;
transdebug("Delimiter: "&symb[1 for 1]&crlf);
if length(symb) ≥ 2 then
BEGIN
symb ← symb[1 for 2];
transdebug("Double delimiter: "&symb&crlf);
out(tablechan,"; DOUBDEL["""&symb&"""] ← TRUE");
doubnum ← doubnum + 1;
doub[doubnum] ← symb
END;
lexan
END;
resnum ← resnum + doubnum;
out(tablechan,crlf&tab&"END;"&crlf&crlf&crlf);
for i ← 0 step 1 until 127 do
charclass[i] ← tempchar[i]; breaktables
END
else if equ(symb,"RESERVED_WORDS") then
BEGIN "reserv"
integer firstres;
debugtrans ← please_answer("List of res. words?");
firstres ← resnum + 1;
out(tablechan,"DEFINE FIRSTRES = ⊂ "&oct(firstres)&" ⊃;"&crlf);
out(tablechan,"PRELOAD_WITH"&crlf);
for i ← 1 step 1 until doubnum do
BEGIN
locresnum ← newres(doub[i], FALSE);
transdebug(crlf&doub[i]&": "&oct(locresnum));
out(tablechan,""""&doub[i]&""","&tab);
if locresnum mod 5 = 0 then
out(tablechan,crlf)
END;
lexan; locresnum ← newres(symb,TRUE);
transdebug(crlf&symb&": "&oct(locresnum));
out(tablechan,""""&symb&"""");
lexan;
while token ≠ "$" ∧ token ≠ tendfile do
BEGIN
locresnum ← newres(symb, TRUE);
transdebug(crlf&symb&": "&oct(locresnum));
out(tablechan,", "); if locresnum mod 5 = 0 then
out(tablechan,crlf);
out(tablechan,""""&symb&"""");
lexan
END;
out(tablechan,";"&crlf&"STRING ARRAY RESWORD["&oct(firstres)
&":"&oct(locresnum)&"];"&crlf&crlf);
out(tablechan,"DEFINE LASTRES = ⊂ "&oct(locresnum)&" ⊃;"&crlf)
END
else if equ(symb,"NON_TERMINAL_SYMBOLS") then
BEGIN "nonterm"
lexan;
debugtrans ← Please_answer("List of non-terminals?");
while token ≠ "$" ∧ token ≠ tendfile do
BEGIN
dummy ← newres(symb,TRUE);
transdebug(crlf&symb&": "&oct(dummy));
lexan
END
END
else if equ(symb,"TYPES") then
BEGIN "types"
debugtrans← please_answer("List of types?");
lexan; while token ≠ "$" ∧ token ≠ tendfile do
BEGIN
dummy ← newtype(symb,TRUE);
transdebug(crlf&symb&": "&oct(dummy));
lexan
END
END
else if equ(symb,"CLASSES") then
BEGIN "classes"
classnum ← 9;
out(tablechan, "DEFINE LOWERCLASS = ⊂ "&oct(resnum)&" ⊃;"&crlf);
lexan;
debugtrans ← please_answer("List of classes?");
while token ≠ "$" ∧ token ≠ tendfile do
BEGIN
integer classno;
while token ≠ "@" do
BEGIN error("No @ before class name."); lexan
END;
lexan;
if token ≠ tnondeclared then
error("Illegal class: "&symb);
classno ← newres(symb,TRUE);
transdebug(crlf&"Class "&oct(classno)&"("&symb&"): Elements ");
lexan;
while token ≠ "@" ∧ token ≠ "$" do
BEGIN
integer hashval, element;
if token = ttype then
element ← entri:val[new_id]
else if token = tstring then
BEGIN
if length(symb) = 2 then
BEGIN
if ¬searchinsert(symb) then
error("Unknown element: "&symb)
else element ← entri:rtype[new_id]
END
else element ← symb
END
else
element ← token;
hashval ← element mod 10;
transdebug(symb&"("&oct(element)&") ");
if member[hashval] = 0 then
BEGIN
member[hashval] ← element land '7777;
class[hashval] ← classno land '7777
END
else
BEGIN
while nextpair[hashval] ≠ 0 do
hashval ← nextpair[hashval];
nextpair[hashval] ← classnum ← classnum + 1;
if classnum = 700 then
error("Make arrays member, etc. larger");
member[classnum] ← element land '7777;
class[classnum] ← classno land '7777
END;
lexan
END
END;
out(tablechan,"PRELOAD_WITH"&crlf);
dummy ← 0;
debugtrans ← please_answer("List of triples?");
for i ← -9 step 1 until classnum do
BEGIN
transdebug(crlf&"triple "&oct(i)&":"&tab&oct(member[i])&tab&
oct(class[i])&tab&oct(nextpair[i]));
out(tablechan,"'"&cvos(member[i] lsh 24 + class[i] lsh 12 + nextpair[i])&","&tab);
if i mod 5 = 0 then
out(tablechan,crlf)
END;
out(tablechan,"0 ;"&crlf&"INTEGER ARRAY HASHCLASS[-9:"&oct(classnum + 1)&"];"&crlf&crlf&crlf);
out(tablechan, "DEFINE UPPERCLASS = ⊂ "&oct(resnum + 1)&" ⊃;"&crlf&crlf);
END
else if equ(symb,"PRODUCTIONS") then
BEGIN "prod"
integer tsame, tscan, tany;
tsame ← newres("SAME",FALSE);
tscan ← newres("SCAN",FALSE);
tany ← newres("ANY",FALSE);
out(tablechan,"PRELOAD_WITH"&crlf);
open_lookup_enter(execfile,exechan,
"DSK",0,0,17,
execount,execbrchar,execeof);
out(exechan, "SIMPLE PROCEDURE EXEC(VALUE INTEGER EXNUM);"&
crlf&tab&"CASE EXNUM OF"&crlf&tab&"BEGIN");
debugtrans ← please_answer("Debug productions?");
lexan; while token ≠ "$" ∧ token ≠ tendfile do
BEGIN
integer prodlength, prodexecnum, numsucc, numfail, stackcode;
integer leftnum ;integer array left, left_pointer[1:20];
integer rightnum;integer array right[1:20];
boolean endexec;
! Process label;
transdebug(crlf&crlf&"Production beginning at element "&
oct(bytenum div 3 + 1)&"["&cvs(bytenum mod 3)&"]");
while token = tlabel ∨ token = tnondeclared do
BEGIN "label"
string sym;
dummy ← evalabel; sym ← symb;
if dummy > 200 then
error("More than 200 labels");
labels[dummy] ← bytenum + 1;
transdebug(" (Will point at"&
oct(bytenum div 3 + 1)&"["&cvs(bytenum mod 3)&"])");
lexan; if token ≠ ":" then
error("Inserting colon after label "&sym)
else
lexan;
END;
! Process left-hand-side;
transdebug(crlf&tab&"Left_hand side: ");
leftnum ← 0;
while token ≠ "→" do
BEGIN "left"
if token = tany then
token ← 0
else if token = tidentifier then
BEGIN
if token = ttype then
token ← entri:val[new_id]
else if token = tnondeclared
∨ token = tsanstype then
BEGIN
error("Undeclared identifier: "&symb);
dummy ← newtype(symb,TRUE)
END
END
else if token = tstring then
BEGIN
if charclass[symb] ≠ delimiter then
error("unknown left element: """&symb&"""")
else if length(symb) = 1 then
token ← symb
else if length(symb) = 2 ∧ searchinsert(symb) then
token ← entri:rtype[new_id]
else
error("unknown left element: """&symb&"""")
END
else if token ≠ tdelimiter then
error("Unknown left element: "&symb);
leftnum ← leftnum + 1;
transdebug(oct(token)&"("&symb&"); ");
if leftnum > 20 then
error("Left-hand side too long");
left[leftnum] ← token;
lexan; if token = "[" then
BEGIN
lexan; left_pointer[cvd(symb)] ← leftnum;
lexan; if token ≠ "]" then
error(NULL)
else
lexan
END
END;
! Process right-hand-side;
transdebug(crlf&tab&"Right_hand side: ");
rightnum ← 0;
lexan; while token ≠ ";" do
BEGIN "right"
rightnum ← rightnum + 1;
transdebug(oct(token)&"("&symb&"); ");
if token = tinteger then
BEGIN
integer ptr;
if (ptr ← left_pointer[cvd(symb)]) = rightnum then
right[rightnum] ← 0
else
BEGIN
if ptr = 0 then
error(symb&" points to what?");
right[rightnum] ← -ptr
END
END
else if token = tsame then
right[rightnum] ← 0
else if token = tstring then
BEGIN
if length(symb) = 1 then
right[rightnum] ← symb
else if searchinsert(symb) then
right[rightnum] ← entri:rtype[new_id]
else
error("Undeclared string: "&symb)
END
else if token ≤ 0 then
error("Illegal right term: "&symb)
else
right[rightnum] ← token;
lexan
END;
! Process exec routines;
lexan; numscan ← prodexecnum ← 0; endexec ← FALSE;
while ¬endexec do
BEGIN "exec"
if token = tscan then
BEGIN
lexan; if token = tinteger then
BEGIN
numscan ← cvd(symb); lexan
END
else
numscan ← 1;
END
else if token = tnondeclared then
BEGIN
entri:rtype[new_id] ← tprocedure;
entri:val[new_id] ← execnum ← execnum + 1;
out(exechan,";"&crlf&tab&tab&symb);
prodexecnum ← prodexecnum + 1;
exec[prodexecnum] ← execnum;
transdebug(crlf&tab&symb&" is now procedure "&oct(execnum));
lexan
END
else if token = tprocedure then
BEGIN
prodexecnum ← prodexecnum + 1;
exec[prodexecnum] ← entri:val[new_id];
transdebug(crlf&tab&symb&" is procedure "&oct(execnum));
lexan
END
else
endexec ← TRUE
END;
! Process branch instructions;
numsucc ← numfail ← stackcode ← 0;
if token = "↓" then
BEGIN lexan; stackcode ← evalabel; lexan
END
else if token = "↑" then
BEGIN stackcode ← -1; lexan
END;
if token = "≡" then
BEGIN
lexan; numsucc ← evalabel; lexan;
END;
if token = "¬" then
BEGIN
lexan; numfail ← evalabel; lexan;
END;
if token = ";" then
lexan;
! Code and store production;
prodlength ← 1 + 1 + leftnum + 1 + rightnum + 1 +
prodexecnum + 1 + 1 + 1;
if numfail = 0 then
BEGIN
numfail ← - (bytenum + prodlength + 1);
transdebug(crlf&tab&"Failure address: "&
oct((-numfail+2) div 3)&"["&
cvs((-numfail+2) mod 3) &"]")
END;
stornum(numfail);
stornum(leftnum); if leftnum >0 then
for i ← 1 step 1 until leftnum do
stornum(left[i]);
stornum(rightnum); if rightnum > 0 then
for i ← 1 step 1 until rightnum do
stornum(right[i]);
stornum(prodexecnum); if prodexecnum > 0 then
for i ← 1 step 1 until prodexecnum do
stornum(exec[i]);
stornum(numscan);
stornum(numsucc);
transdebug(crlf&tab&"Stackcode: "&cvos(stackcode));
stornum(stackcode)
END;
stornum(0);
prodwordnum ← prodwordnum + 1;
out(tablechan,"'"&cvos(el0 lsh 24 + el1 lsh 12 + el2)&";"&crlf);
out(tablechan,"INTEGER ARRAY PRODUCTION[1:"&
oct(prodwordnum)&"];");
close(tablechan);
out(exechan,crlf&tab&"END;"); close(exechan)
END
else
BEGIN
error("Unknown heading: "&symb);
outstr("Try again:"); symb ← instrl(cr);
if symb = NULL then
token ← tendfile
END
END
until token = tendfile;
! Update tables;
labfile ← "LAB.SAI[BBB,BBM]";
out(labchan,"PRELOAD_WITH"&crlf);
rounded ← labnum + 2 - (labnum -1) MOD 3;
if rounded > labnum then
BEGIN
for i ← labnum + 1 step 1 until rounded do labels[i] ← 1;
labnum ← rounded
END;
for i ← 1 step 3 until labnum do
BEGIN
integer l1, l2, l3, j;
l1 ← labels[i] land '7777; l2 ← labels[i+1] land '7777; l3 ← labels[i +2] land '7777;
for j ← 0 step 1 until 2 do
if labels[i + j] ≤ 0 then
outstr(crlf&"Label # "&oct(i+j)&" is undefined");
if i mod 15 = 1 then
out(labchan,crlf);
out(labchan,"'"&cvos(l1 lsh 24 + l2 lsh 12 + l3)&", ")
END;
out(labchan,"1;"&crlf&"INTEGER ARRAY LABELS[1:"&oct(labnum div 3 + 1)&"];");
close(labchan)
END